home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyTextDisplay.p < prev    next >
Encoding:
Text File  |  1996-10-16  |  24.4 KB  |  890 lines  |  [TEXT/CWIE]
  1. unit MyTextDisplay;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Windows;
  7.  
  8.     type
  9.         LongArray = array[1..100000] of longint;
  10.         LongArrayPtr = ^LongArray;
  11.         LongArrayHandle = ^LongArrayPtr;
  12.         MyTextDisplayRecord = record
  13. { You can change these and the call resize/recalc }
  14.                 leading: integer;
  15.                 width: integer;
  16.                 leave_room_for_grow: boolean;
  17. { You can read these }
  18.                 full_rect: Rect;
  19.                 view: Rect;
  20.                 full_view: Rect;
  21.                 view_lines: longint;
  22.                 total_length: longint;
  23.                 view_width: integer;
  24.                 top_line: longint;
  25.                 selStart, selEnd: longint;
  26.                 hoffset: integer;
  27.                 window: WindowPtr;
  28.                 hcontrol, vcontrol: ControlHandle;
  29.                 font: integer;
  30.                 size: integer;
  31.                 fi: FontInfo;
  32.                 line_height: longint;
  33.                 rn: integer;
  34.                 lines: longint;
  35. { You should ignore these }
  36.                 last_click_time: longint;
  37.                 last_click_offset: longint;
  38.                 double_click: boolean;
  39.                 offsets: LongArrayHandle;
  40.             end;
  41.         LongPoint = record
  42.                 v: longint;
  43.                 h: longint;
  44.             end;
  45.  
  46.     procedure MTDCreate (var mtd: MyTextDisplayRecord; window: WindowPtr; rn: integer; width: integer; hcontrol: boolean);
  47.     procedure MTDDestroy (var mtd: MyTextDisplayRecord);
  48.  
  49.     procedure MTDSetPort (var mtd: MyTextDisplayRecord);
  50.     procedure MTDSetFontSize (var mtd: MyTextDisplayRecord; font, size: integer);
  51.     procedure MTDRecalculate (var mtd: MyTextDisplayRecord; justappend: boolean);
  52.     procedure MTDDisplay (var mtd: MyTextDisplayRecord; draw_region: RgnHandle; fromline: longint);
  53.     procedure MTDSetSelection (var mtd: MyTextDisplayRecord; start, fin: longint);
  54.     procedure MTDGetSelectionData (var mtd: MyTextDisplayRecord; h: Handle);
  55.     procedure MTDResize (var mtd: MyTextDisplayRecord; view: Rect);
  56.     procedure MTDDoKey (var mtd: MyTextDisplayRecord; ch: char);
  57.     procedure MTDDoClick (var mtd: MyTextDisplayRecord; const er: EventRecord);
  58.     procedure MTDSetMouse (var mtd: MyTextDisplayRecord);
  59.     procedure MTDScroll (var mtd: MyTextDisplayRecord; scroll: LongPoint);
  60.     procedure MTDActivateDeactivate (var mtd: MyTextDisplayRecord; activate: boolean);
  61.  
  62. implementation
  63.  
  64.     uses
  65.         TextUtils, ToolUtils, Devices, Types,
  66.         ICAPI,
  67.         MyTypes, MyInternetConfig, MyMathUtils, MyFileSystemUtils, MyCursors, MyUtils, MyEvents, 
  68.         MyMemory, MyAssertions;
  69.  
  70.     const
  71.         invis = 0;
  72.         vis = 255;
  73.  
  74.     procedure SectRectRgn (rgn: RgnHandle; r: Rect);
  75.         var
  76.             rrgn: RgnHandle;
  77.     begin
  78.         rrgn := NewRgn;
  79.         RectRgn(rrgn, r);
  80.         SectRgn(rgn, rrgn, rgn);
  81.         DisposeRgn(rrgn);
  82.     end;
  83.  
  84.     procedure UnionRectRgn (rgn: RgnHandle; l, t, r, b: integer);
  85.         var
  86.             rrgn: RgnHandle;
  87.     begin
  88.         rrgn := NewRgn;
  89.         SetRectRgn(rrgn, l, t, r, b);
  90.         UnionRgn(rgn, rrgn, rgn);
  91.         DisposeRgn(rrgn);
  92.     end;
  93.  
  94.     function MyFSReadChunkPos (refnum: integer; pos: longint; var len: longint; datap:Ptr): OSErr;
  95.         var
  96.             pb: ParamBlockRec;
  97.             err: OSErr;
  98.     begin
  99.         pb.ioRefNum := refnum;
  100.         pb.ioBuffer := datap;
  101.         pb.ioReqCount := len;
  102.         pb.ioPosMode := fsFromStart;
  103.         pb.ioPosOffset := pos;
  104.         err := PBReadSync(@pb);
  105.         if (err = eofErr) & (pb.ioActCount > 0) then begin
  106.             err := noErr;
  107.         end;
  108.         len := Choose( err = noErr, pb.ioActCount, 0 );
  109.         MyFSReadChunkPos := err;
  110.     end;
  111.  
  112.     function MyFSReadChunkPosLine (refnum: integer; pos: longint; len: integer; var s: Str255): OSErr;
  113.         var
  114.             mylen: longint;
  115.             err: OSErr;
  116.     begin
  117. {$PUSH}
  118. {$R-}
  119.         mylen := Min( len, 255 );
  120.         err := MyFSReadChunkPos( refnum, pos, mylen, @s[1] );
  121.         s[0] := chr(mylen);
  122. {$POP}
  123.         MyFSReadChunkPosLine := err;
  124.     end;
  125.  
  126.     procedure MTDSetPort (var mtd: MyTextDisplayRecord);
  127.     begin
  128.         SetPort(mtd.window);
  129.         TextFont(mtd.font);
  130.         TextSize(mtd.size);
  131.         TextFace([]);
  132.     end;
  133.  
  134.     procedure MTDOffsetToLine (var mtd: MyTextDisplayRecord; offset: longint; var thisline: longint);
  135.         var
  136.             s, m, f: longint;
  137.     begin
  138.         if offset <= 0 then begin
  139.             thisline := 1;
  140.         end else if offset >= mtd.total_length then begin
  141.             thisline := mtd.lines;
  142.         end else begin
  143.             s := 1;
  144.             f := mtd.lines + 1;
  145.             while s < f do begin
  146.                 m := (f + s) div 2;
  147.                 if offset >= mtd.offsets^^[m] then begin
  148.                     s := m;
  149.                 end;
  150.                 if offset < mtd.offsets^^[m + 1] then begin
  151.                     f := m;
  152.                 end;
  153.                 if offset = mtd.offsets^^[m + 1] then begin { cheat to make it work with filelen }
  154.                     s := m + 1;
  155.                     leave;
  156.                 end;
  157.             end;
  158.             thisline := s;
  159.         end;
  160.     end;
  161.  
  162.     procedure MTDSetFontSize (var mtd: MyTextDisplayRecord; font, size: integer);
  163.     begin
  164.         mtd.font := font;
  165.         mtd.size := size;
  166.         if size = 0 then begin
  167.             mtd.leading := 2;
  168.         end else begin
  169.             mtd.leading := size div 6;
  170.             if mtd.leading = 0 then begin
  171.                 mtd.leading := 1;
  172.             end;
  173.         end;
  174.         MTDSetPort(mtd);
  175.         GetFontInfo(mtd.fi);
  176.         mtd.line_height := mtd.fi.ascent + mtd.fi.descent + mtd.leading;
  177.     end;
  178.  
  179.     procedure MTDSetControls (var mtd: MyTextDisplayRecord);
  180.         var
  181.             m: integer;
  182.     begin
  183.         mtd.vcontrol^^.contrlVis := invis;
  184.         m := Max(0, mtd.lines - mtd.view_lines);
  185.         SetControlMaximum(mtd.vcontrol, m);
  186.         mtd.top_line := Pin(0, mtd.top_line, m);
  187.         SetControlValue(mtd.vcontrol, mtd.top_line);
  188.         mtd.vcontrol^^.contrlVis := vis;
  189.         Draw1Control(mtd.vcontrol);
  190.  
  191.         if mtd.hcontrol <> nil then begin
  192.             mtd.hcontrol^^.contrlVis := invis;
  193.             m := Max(0, mtd.width - mtd.view_width);
  194.             SetControlMaximum(mtd.hcontrol, m);
  195.             mtd.hoffset := Pin(0, mtd.hoffset, m);
  196.             SetControlValue(mtd.hcontrol, mtd.hoffset);
  197.             mtd.hcontrol^^.contrlVis := vis;
  198.             Draw1Control(mtd.hcontrol);
  199.         end;
  200.     end;
  201.  
  202.     procedure MTDRecalculate (var mtd: MyTextDisplayRecord; justappend: boolean);
  203.         var
  204.             err: OSErr;
  205.             handlesize: longint;
  206.             pos, nextpos: longint;
  207.             offset, linebytes: longint;
  208.             filelen: longint;
  209.             line: Str255;
  210.             slbc: StyledLineBreakCode;
  211.             textwidth: Fixed;
  212.             orgoffset: longint;
  213.             thisline: longint;
  214.             initialline: longint;
  215.     begin
  216.         MTDSetPort(mtd);
  217.         mtd.last_click_time := 0;
  218.         handlesize := GetHandleSize(Handle(mtd.offsets)) div 4;
  219.         err := GetEOF(mtd.rn, filelen);
  220.         mtd.total_length := filelen;
  221.         if justappend & (mtd.lines > 1) then begin
  222.             mtd.lines := mtd.lines - 1;
  223.             pos := mtd.offsets^^[mtd.lines + 1];
  224.             orgoffset := maxLongInt;
  225.             initialline := 0; {mtd.lines}
  226.         end else begin
  227.             orgoffset := mtd.offsets^^[Min(mtd.lines + 1, mtd.top_line + 1)];
  228.             mtd.lines := 0;
  229.             pos := 0;
  230.             initialline := 0;
  231.         end;
  232.         if err = noErr then begin
  233.             err := MyFSReadLineAt(mtd.rn, pos, line);
  234.             while err = noErr do begin
  235.                 nextpos := pos + length(line) + 1;
  236.                 offset := 0;
  237.                 while (offset = 0) or (offset < length(line)) do begin
  238.                     textwidth := BSL(mtd.width, 16);
  239.                     linebytes := 1;
  240.                     slbc := StyledLineBreak(@line[offset + 1], length(line) - offset, 0, length(line) - offset, 0, textwidth, linebytes);
  241.                     mtd.lines := mtd.lines + 1;
  242.                     if mtd.lines > handlesize then begin
  243.                         handlesize := handlesize + 100;
  244.                         SetHandleSize(Handle(mtd.offsets), handlesize * 4);
  245.                     end;
  246.                     mtd.offsets^^[mtd.lines] := pos + offset;
  247.                     if linebytes = 0 then begin
  248.                         offset := offset + 1;
  249.                     end else begin
  250.                         offset := offset + linebytes;
  251.                     end;
  252.                 end;
  253.                 pos := nextpos;
  254.                 err := MyFSReadLineAt(mtd.rn, pos, line);
  255.             end;
  256.         end;
  257.         SetHandleSize(Handle(mtd.offsets), (mtd.lines + 1) * 4);
  258.         mtd.offsets^^[mtd.lines + 1] := filelen;
  259.         mtd.hoffset := 0;
  260.         MTDOffsetToLine(mtd, orgoffset, thisline);
  261.         mtd.top_line := Max(0, Min(thisline - 1, mtd.lines - mtd.view_lines));
  262.         MTDSetControls(mtd);
  263.         MTDDisplay(mtd, nil, initialline);
  264.     end;
  265.  
  266.     function MTDLinePosToHOffset (var mtd: MyTextDisplayRecord; var line: Str255; linepos: integer): integer;
  267.     begin
  268. {$PUSH}
  269. {$R-}
  270.         MTDLinePosToHOffset := Char2Pixel(@line[1], length(line), 0, linepos, 1) + mtd.view.left - mtd.hoffset;
  271. {$POP}
  272.     end;
  273.  
  274.     function MTDHOffsetToLinePos (var mtd: MyTextDisplayRecord; var line: Str255; hoffset: integer; var rightside: boolean): integer;
  275.         var
  276.             linepos: integer;
  277.     begin
  278. {$unused(mtd)}
  279. {$PUSH}
  280. {$R-}
  281.         linepos := Pixel2Char(@line[1], length(line), 0, hoffset, rightside);
  282. {$POP}
  283.         rightside := rightside <> false;
  284.         MTDHOffsetToLinePos := linepos;
  285.     end;
  286.  
  287.     procedure MTDDisplay (var mtd: MyTextDisplayRecord; draw_region: RgnHandle; fromline: longint);
  288.         var
  289.             line: Str255;
  290.         function LineSelectionPos (thisline, o: longint): integer;
  291.             var
  292.                 base, pos: longint;
  293.         begin
  294.             base := mtd.offsets^^[thisline];
  295.             if o <= base then begin
  296.                 LineSelectionPos := mtd.view.left;
  297.             end else if o >= mtd.offsets^^[thisline + 1] then begin
  298.                 LineSelectionPos := mtd.view.right;
  299.             end else begin
  300.                 pos := MTDLinePosToHOffset(mtd, line, o - base);
  301.                 if pos < mtd.view.left then begin
  302.                     pos := mtd.full_view.left;
  303.                 end else if pos >= mtd.view.right then begin
  304.                     pos := mtd.full_view.right;
  305.                 end;
  306.                 LineSelectionPos := pos;
  307.             end;
  308.         end;
  309.  
  310.         var
  311.             err: OSErr;
  312.             v: integer;
  313.             thisline: longint;
  314.             s, f: longint;
  315.             sh, fh: integer;
  316.             oldclip: RgnHandle;
  317.             r: Rect;
  318.     begin
  319.         MTDSetPort(mtd);
  320.         oldclip := NewRgn;
  321.         GetClip(oldclip);
  322.         if draw_region = nil then begin
  323.             ClipRect(mtd.view);
  324.         end else begin
  325.             SectRectRgn(draw_region, mtd.view);
  326.             SetClip(draw_region);
  327.         end;
  328.         v := mtd.view.top + mtd.leading + mtd.fi.ascent;
  329.         for thisline := mtd.top_line + 1 to Min(mtd.lines, mtd.top_line + mtd.view_lines) do begin
  330.             if thisline >= fromline then begin
  331.                 err := MyFSReadChunkPosLine(mtd.rn, mtd.offsets^^[thisline], mtd.offsets^^[thisline + 1] - mtd.offsets^^[thisline], line);
  332.                 if err <> noErr then begin
  333.                     leave;
  334.                 end;
  335.                 r := mtd.view;
  336.                 r.top := v - mtd.fi.ascent - mtd.leading;
  337.                 r.bottom := v + mtd.fi.descent;
  338.                 MoveTo(mtd.view.left - mtd.hoffset, v);
  339.                 EraseRect(r);
  340.                 DrawString(line);
  341.                 s := mtd.selStart;
  342.                 f := mtd.selEnd;
  343.                 if (s < f) & (s < mtd.offsets^^[thisline + 1]) & (mtd.offsets^^[thisline] < f) then begin { Selection }
  344.                     sh := LineSelectionPos(thisline, s);
  345.                     fh := LineSelectionPos(thisline, f);
  346.                     SetRect(r, sh, v - mtd.fi.ascent - mtd.leading, fh, v + mtd.fi.descent);
  347.                     HiliteInvertRect(r);
  348.                 end;
  349.             end;
  350.             v := v + mtd.line_height;
  351.         end;
  352.         SetClip(oldclip);
  353.         DisposeRgn(oldclip);
  354.     end;
  355.  
  356.     procedure MTDScroll (var mtd: MyTextDisplayRecord; scroll: LongPoint);
  357.         var
  358.             update: RgnHandle;
  359.     begin
  360.         scroll.v := Pin(-mtd.top_line, scroll.v, Max(0, mtd.lines - mtd.top_line - mtd.view_lines));
  361.         scroll.h := Pin(-mtd.hoffset, scroll.h, Max(0, mtd.width - mtd.hoffset - mtd.view_width));
  362.         if (scroll.v <> 0) or (scroll.h <> 0) then begin
  363.             update := NewRgn;
  364.             ScrollRect(mtd.view, -scroll.h, -scroll.v * mtd.line_height, update);
  365.             mtd.hoffset := mtd.hoffset + scroll.h;
  366.             mtd.top_line := mtd.top_line + scroll.v;
  367.             MTDDisplay(mtd, update, 0);
  368.             DisposeRgn(update);
  369.             MTDSetControls(mtd);
  370.         end;
  371.     end;
  372.  
  373.     procedure MTDPointToOffset (var mtd: MyTextDisplayRecord; pt: Point; var thisline, offset: longint; var rightside: boolean; var line: Str255; var scroll: LongPoint);
  374.         var
  375.             last_line: longint;
  376.             h: integer;
  377.             err: OSErr;
  378.     begin
  379.         rightside := false;
  380.         scroll.h := 0;
  381.         scroll.v := 0;
  382.         line := '';
  383.         last_line := Min(mtd.top_line + mtd.view_lines, mtd.lines);
  384.         if pt.v < mtd.full_view.top then begin
  385.             scroll.v := -((mtd.view.top - pt.v) div mtd.line_height + 1);
  386.             offset := mtd.offsets^^[mtd.top_line + 1];
  387.             thisline := mtd.top_line + 1;
  388.         end else if pt.v > mtd.full_view.bottom then begin
  389.             scroll.v := (pt.v - mtd.view.bottom) div mtd.line_height + 1;
  390.             offset := mtd.offsets^^[last_line + 1];
  391.             thisline := last_line;
  392.             rightside := false;
  393.         end else begin
  394.             if pt.h < mtd.full_view.left then begin
  395.                 scroll.h := pt.h - mtd.view.left;
  396.             end else if pt.h > mtd.full_view.right then begin
  397.                 scroll.h := pt.h - mtd.view.right;
  398.             end else begin
  399.                 pt.h := Pin(mtd.view.left, pt.h, mtd.view.right);
  400.             end;
  401.             thisline := mtd.top_line + (pt.v - mtd.view.top) div mtd.line_height + 1;
  402.             if thisline > mtd.lines then begin
  403.                 thisline := mtd.lines + 1;
  404.                 offset := mtd.total_length;
  405.                 rightside := false;
  406.             end else begin
  407.                 h := Max(0, pt.h - mtd.view.left + mtd.hoffset);
  408.                 err := MyFSReadChunkPosLine(mtd.rn, mtd.offsets^^[thisline], mtd.offsets^^[thisline + 1] - mtd.offsets^^[thisline], line);
  409.                 offset := MTDHOffsetToLinePos(mtd, line, h, rightside);
  410.                 if offset >= length(line) then begin
  411.                     offset := length(line);
  412.                     rightside := false;
  413.                 end;
  414.                 offset := mtd.offsets^^[thisline] + offset;
  415.             end;
  416.         end;
  417.     end;
  418.  
  419.     procedure MTDReadLine (var mtd: MyTextDisplayRecord; theline: longint; var line: Str255);
  420.         var
  421.             err: OSErr;
  422.     begin
  423.         line := '';
  424.         if theline <= mtd.lines then begin
  425.             err := MyFSReadChunkPosLine(mtd.rn, mtd.offsets^^[theline], mtd.offsets^^[theline + 1], line);
  426.         end;
  427.     end;
  428.  
  429.     procedure MTDOffsetToPoint (var mtd: MyTextDisplayRecord; offset: longint; var pt: Point);
  430.         var
  431.             thisline: longint;
  432.             line: Str255;
  433.     begin
  434.         MTDOffsetToLine(mtd, offset, thisline);
  435.         if thisline <= mtd.top_line then begin
  436.             pt := mtd.view.topLeft;
  437.             pt.v := pt.v - mtd.line_height;
  438.         end else if thisline >= mtd.top_line + mtd.view_lines + 1 then begin
  439.             pt := mtd.view.botRight;
  440.             pt.v := pt.v + mtd.line_height;
  441.         end else begin
  442.             MTDReadLine(mtd, thisline, line);
  443.             pt.v := mtd.view.top + mtd.leading + mtd.fi.ascent + (thisline - mtd.top_line - 1) * mtd.line_height;
  444.             pt.h := MTDLinePosToHOffset(mtd, line, offset - mtd.offsets^^[thisline]);
  445.         end;
  446.     end;
  447.  
  448.     procedure MTDGetSelectionData (var mtd: MyTextDisplayRecord; h: Handle);
  449.         var
  450.             err: OSErr;
  451.     begin
  452.         HUnlock(h);
  453.         SetHandleSize(h, 0);
  454.         SetHandleSize(h, mtd.selEnd - mtd.selStart);
  455.         err := MyFSReadAt(mtd.rn, mtd.selStart, GetHandleSize(h), h^);
  456.         if err <> noErr then begin
  457.             SetHandleSize(h, 0);
  458.         end;
  459.     end;
  460.  
  461.     procedure MTDSetSelection (var mtd: MyTextDisplayRecord; start, fin: longint);
  462.         function InView (v: integer): boolean;
  463.         begin
  464.             InView := (mtd.view.top <= v) & (v <= mtd.view.bottom);
  465.         end;
  466.         procedure GetSelRgn (s, f: longint; r: RgnHandle);
  467.             var
  468.                 sp, fp: Point;
  469.                 ascent, descent, leading, left, right, top, bottom: integer;
  470.                 t, b: integer;
  471.         begin
  472.             if s < f then begin
  473.                 MTDOffsetToPoint(mtd, s, sp);
  474.                 MTDOffsetToPoint(mtd, f, fp);
  475.                 ascent := mtd.fi.ascent + mtd.leading;
  476.                 descent := mtd.fi.descent;
  477.                 leading := mtd.fi.leading;
  478.                 left := mtd.view.left;
  479.                 right := mtd.view.right;
  480.                 top := mtd.view.top;
  481.                 bottom := mtd.view.bottom;
  482.                 if sp.v = fp.v then begin
  483.                     if InView(sp.v) then begin
  484.                         SetRectRgn(r, sp.h, sp.v - ascent - leading, fp.h, sp.v + descent);
  485.                     end;
  486.                 end else begin
  487.                     if InView(sp.v) then begin
  488.                         SetRectRgn(r, sp.h, sp.v - ascent - leading, right, sp.v + descent);
  489.                         t := sp.v + descent;
  490.                     end else begin
  491.                         t := top;
  492.                     end;
  493.                     if InView(fp.v) then begin
  494.                         UnionRectRgn(r, left, fp.v - ascent - leading, fp.h, fp.v + descent);
  495.                         b := fp.v - ascent;
  496.                     end else begin
  497.                         b := bottom;
  498.                     end;
  499.                     UnionRectRgn(r, left, t, right, b);
  500.                 end;
  501.             end;
  502.             SectRectRgn(r, mtd.full_view);
  503.         end;
  504.         var
  505.             orgn, nrgn: RgnHandle;
  506.     begin
  507.         if (start <> mtd.selStart) or (fin <> mtd.selEnd) then begin
  508.             MTDSetPort(mtd);
  509.             orgn := NewRgn;
  510.             nrgn := NewRgn;
  511.             GetSelRgn(mtd.selStart, mtd.selEnd, orgn);
  512.             mtd.selStart := start;
  513.             mtd.selEnd := fin;
  514.             GetSelRgn(mtd.selStart, mtd.selEnd, nrgn);
  515.             XorRgn(orgn, nrgn, nrgn);
  516.             HiliteInvertRgn(nrgn);
  517.             DisposeRgn(nrgn);
  518.             DisposeRgn(orgn);
  519.         end;
  520.     end;
  521.  
  522.     procedure MTDResize (var mtd: MyTextDisplayRecord; view: Rect);
  523.         var
  524.             inset: integer;
  525.     begin
  526.         mtd.vcontrol^^.contrlVis := invis;
  527.         if mtd.hcontrol <> nil then begin
  528.             mtd.hcontrol^^.contrlVis := invis;
  529.         end;
  530.  
  531.         EraseRect(mtd.full_rect);
  532.         InvalRect(mtd.full_rect);
  533.  
  534.         mtd.full_rect := view;
  535.         mtd.view := view;
  536.         mtd.view.right := view.right - 16;
  537.         if (mtd.hcontrol <> nil) then begin
  538.             mtd.view.bottom := mtd.view.bottom - 16;
  539.         end;
  540.         mtd.full_view := mtd.view;
  541.         inset := Max(mtd.leading, 3);
  542.         InsetRect(mtd.view, inset, inset);
  543.         mtd.view_lines := (mtd.view.bottom - mtd.view.top) div mtd.line_height;
  544.         mtd.view.bottom := mtd.view.top + mtd.view_lines * mtd.line_height;
  545.         mtd.view_width := mtd.view.right - mtd.view.left;
  546.         if mtd.width = 0 then begin
  547.             mtd.width := mtd.view_width;
  548.         end;
  549.  
  550.         MoveControl(mtd.vcontrol, view.right - 15, view.top - 1);
  551.         SizeControl(mtd.vcontrol, 16, view.bottom - view.top - 16 * ord(mtd.leave_room_for_grow) + 3);
  552.  
  553.         if mtd.hcontrol <> nil then begin
  554.             MoveControl(mtd.hcontrol, view.left - 1, view.bottom - 15);
  555.             SizeControl(mtd.hcontrol, view.right - view.left - 13, 16);
  556.         end;
  557.  
  558.         MTDRecalculate(mtd, false);
  559.     end;
  560.  
  561.     procedure MTDCreate (var mtd: MyTextDisplayRecord; window: WindowPtr; rn: integer; width: integer; hcontrol: boolean);
  562.         var
  563.             bounds: Rect;
  564.     begin
  565.         mtd.window := window;
  566.         SetRect(mtd.view, 0, 0, 0, 0);
  567.         mtd.width := width;
  568.         mtd.leave_room_for_grow := true;
  569.         mtd.rn := rn;
  570.         mtd.lines := 0;
  571.         mtd.total_length := 0;
  572.         mtd.top_line := 0;
  573.         mtd.hoffset := 0;
  574.         mtd.selStart := 0;
  575.         mtd.selEnd := 0;
  576.         mtd.last_click_time := 0;
  577.         mtd.offsets := LongArrayHandle(NewHandleClear(4));
  578.         SetRect(bounds, 0, 0, 15, 100);
  579.         mtd.vcontrol := NewControl(window, bounds, '', false, 0, 0, 0, scrollBarProc, ord(@mtd));
  580.         if hcontrol then begin
  581.             SetRect(bounds, 0, 0, 100, 15);
  582.             mtd.hcontrol := NewControl(window, bounds, '', false, 0, 0, 0, scrollBarProc, ord(@mtd));
  583.         end else begin
  584.             mtd.hcontrol := nil;
  585.         end;
  586.         MTDSetFontSize(mtd, 0, 0);
  587.     end;
  588.  
  589.     var
  590.         action_mte: ^MyTextDisplayRecord;
  591.         action_amount: LongPoint;
  592.  
  593.     procedure MTDAction (control: ControlHandle; part: integer);
  594.     begin
  595. {$unused(control)}
  596.         if (part <> 0) then begin
  597.             MTDScroll(action_mte^, action_amount);
  598.         end;
  599.     end;
  600.  
  601.     procedure GetActionAmount (var mtd: MyTextDisplayRecord; control: ControlHandle; part: integer; var scroll: LongPoint);
  602.         var
  603.             amount, amount_pg, amount_line: integer;
  604.     begin
  605.         if control = mtd.vcontrol then begin
  606.             amount_pg := mtd.view_lines - 1;
  607.             amount_line := 1;
  608.         end else begin
  609.             amount_pg := mtd.view_width;
  610.             amount_line := 8; { a few pixels }
  611.         end;
  612.         case part of
  613.             kControlUpButtonPart: 
  614.                 amount := -amount_line;
  615.             kControlDownButtonPart: 
  616.                 amount := amount_line;
  617.             kControlPageUpPart: 
  618.                 amount := -amount_pg;
  619.             kControlPageDownPart: 
  620.                 amount := amount_pg;
  621.             otherwise begin
  622.                 amount := 0;
  623.             end;
  624.         end;
  625.         if control = mtd.vcontrol then begin
  626.             scroll.h := 0;
  627.             scroll.v := amount;
  628.         end else begin
  629.             scroll.h := amount;
  630.             scroll.v := 0;
  631.         end;
  632.     end;
  633.  
  634.     procedure DoCommandClick(var mtd: MyTextDisplayRecord; offset: longint);
  635.         var
  636.             space: packed array[0..4095] of Byte;
  637.             urlStart, urlEnd: longint;
  638.             spaceStart, spaceEnd: longint;
  639.             len: longint;
  640.             err: OSStatus;
  641.             f: longint;
  642.     begin
  643.         if (mtd.selStart < mtd.selEnd) & (mtd.selStart <= offset) & (offset <= mtd.selEnd) & (mtd.selStart + SizeOf(space) > mtd.selEnd) then begin
  644.             { we have a smallish selection and we cmd-clicked in it }
  645.             urlStart := mtd.selStart;
  646.             urlEnd := mtd.selEnd;
  647.         end else begin
  648.             urlStart := offset;
  649.             urlEnd := offset;
  650.         end;
  651.         spaceStart := Max( 0, urlStart - ((SizeOf(space) - (urlEnd - urlStart)) div 2) );
  652.         spaceEnd := Min( spaceStart + SizeOf(space), mtd.total_length );
  653.         len := spaceEnd - spaceStart;
  654.         err := MyFSReadChunkPos( mtd.rn, spaceStart, len, @space );
  655.         if (err = noErr) & (len <> spaceEnd - spaceStart) then begin
  656.             err := -1;
  657.         end;
  658.         if err = noErr then begin
  659.             urlStart := urlStart - spaceStart;
  660.             urlEnd := urlEnd - spaceStart;
  661.             err := ICLaunchURL (internet_config_instance, '', @space, len, urlStart, urlEnd);
  662.             urlStart := urlStart + spaceStart;
  663.             urlEnd := urlEnd + spaceStart;
  664.         end;
  665.         if err = noErr then begin
  666.             MTDSetSelection(mtd, urlStart, urlEnd);
  667.             Delay( 6, f );
  668.             MTDSetSelection(mtd, urlStart, urlStart);
  669.             Delay( 6, f );
  670.             MTDSetSelection(mtd, urlStart, urlEnd);
  671.         end else begin
  672.             SysBeep( 1 );
  673.         end;
  674.     end;
  675.     
  676.     procedure MTDDoClick (var mtd: MyTextDisplayRecord; const er: EventRecord);
  677.         var
  678.             click_type: (CT_First, CT_Double, CT_Tripple);
  679.             rightside: boolean;
  680.             thisline: longint;
  681.             line: Str255;
  682.         procedure GetCurrentPos (offset: longint; var s, f: longint);
  683.             var
  684.                 base: longint;
  685.                 offtab: OffsetTable;
  686.         begin
  687.             base := mtd.offsets^^[thisline];
  688.             case click_type of
  689.                 CT_First:  begin
  690.                     s := offset + ord(rightside);
  691.                     f := offset + ord(rightside);
  692.                 end;
  693.                 CT_Double:  begin
  694. {$PUSH}
  695. {$R-}
  696.                     FindWord(@line[1], length(line), offset - base, rightside, nil, offtab);
  697. {$POP}
  698.                     s := base + offtab[0].offFirst;
  699.                     f := base + offtab[0].offSecond;
  700.                 end;
  701.                 CT_Tripple:  begin
  702.                     s := base;
  703.                     if thisline <= mtd.lines then begin
  704.                         f := mtd.offsets^^[thisline + 1];
  705.                     end else begin
  706.                         f := base;
  707.                     end;
  708.                 end;
  709.             end; { case }
  710.         end;
  711.  
  712.         var
  713.             pt: Point;
  714.             control: ControlHandle;
  715.             part: integer;
  716.             scroll: LongPoint;
  717.             offset, ancors, ancorf, s, f, value: longint;
  718.             shift: boolean;
  719.             amount: longint;
  720.             MTDActionProc:UniversalProcPtr;
  721.     begin
  722.         MTDSetPort(mtd);
  723.         pt := er.where;
  724.         GlobalToLocal(pt);
  725.         if PtInRect(pt, mtd.full_view) then begin
  726.             shift := EventHasShiftKey( er );
  727.             MTDPointToOffset(mtd, pt, thisline, offset, rightside, line, scroll);
  728.             if EventHasCommandKey( er ) then begin
  729.                 DoCommandClick( mtd, offset );
  730.             end else begin
  731.                 if not shift & (er.when - mtd.last_click_time <= GetDblTime) & (offset = mtd.last_click_offset) then begin
  732.                     if mtd.double_click then begin
  733.                         click_type := CT_Tripple;
  734.                     end else begin
  735.                         click_type := CT_Double;
  736.                     end;
  737.                     mtd.double_click := true;
  738.                 end else begin
  739.                     click_type := CT_First;
  740.                     mtd.double_click := false;
  741.                     mtd.last_click_offset := offset;
  742.                 end;
  743.                 if not shift then begin
  744.                     GetCurrentPos(offset, ancors, ancorf);
  745.                 end else begin
  746.                     if mtd.selStart < mtd.selEnd then begin
  747.                         if offset > mtd.selStart then begin
  748.                             ancors := mtd.selStart;
  749.                             ancorf := mtd.selStart;
  750.                         end else begin
  751.                             ancors := mtd.selEnd;
  752.                             ancorf := mtd.selEnd;
  753.                         end;
  754.                     end else begin
  755.                         ancors := offset;
  756.                         ancorf := offset;
  757.                     end;
  758.                 end;
  759.                 MTDSetSelection(mtd, ancors, ancorf);
  760.                 while StillDown do begin
  761.                     GetMouse(pt);
  762.                     MTDPointToOffset(mtd, pt, thisline, offset, rightside, line, scroll);
  763.                     GetCurrentPos(offset, s, f);
  764.                     MTDSetSelection(mtd, Min(ancors, s), Max(ancorf, f));
  765.                     MTDScroll(mtd, scroll);
  766.                 end;
  767.                 mtd.last_click_time := TickCount;
  768.             end;
  769.         end else begin
  770.             part := FindControl(pt, mtd.window, control);
  771.             if part <> 0 then begin
  772.                 if part = kControlIndicatorPart then begin
  773.                     value := GetControlValue(control);
  774.                     part := TrackControl(control, pt, nil);
  775.                     if part <> 0 then begin
  776.                         amount := GetControlValue(control) - value;
  777.                         if amount <> 0 then begin
  778.                             if control = mtd.vcontrol then begin
  779.                                 scroll.v := amount;
  780.                                 scroll.h := 0;
  781.                             end else begin
  782.                                 scroll.h := amount;
  783.                                 scroll.v := 0;
  784.                             end;
  785.                             MTDScroll(mtd, scroll);
  786.                         end;
  787.                     end;
  788.                 end else begin
  789.                     GetActionAmount(mtd, control, part, action_amount);
  790.                     action_mte := @mtd;
  791.                     MTDActionProc := NewControlActionProc(MTDAction);
  792.                     value := TrackControl(control, pt, MTDActionProc);
  793.                     DisposeRoutineDescriptor(MTDActionProc);
  794.                 end;
  795.             end else begin
  796.                 SysBeep(1);
  797.             end;
  798.         end;
  799.     end;
  800.  
  801.     procedure MTDDoKey (var mtd: MyTextDisplayRecord; ch: char);
  802.         var
  803.             scroll: LongPoint;
  804.     begin
  805.         scroll.h := 0;
  806.         scroll.v := 0;
  807.         case ord(ch) of
  808.             homeChar:  begin
  809.                 scroll.v := -mtd.lines;
  810.             end;
  811.             endChar:  begin
  812.                 scroll.v := mtd.lines;
  813.             end;
  814.             pageUpChar:  begin
  815.                 GetActionAmount(mtd, mtd.vcontrol, kControlPageUpPart, scroll);
  816.             end;
  817.             pageDownChar:  begin
  818.                 GetActionAmount(mtd, mtd.vcontrol, kControlPageDownPart, scroll);
  819.             end;
  820.             otherwise begin
  821.                 SysBeep(1);
  822.             end;
  823.         end;
  824.         MTDScroll(mtd, scroll);
  825.     end;
  826.  
  827.     procedure MTDSetMouse (var mtd: MyTextDisplayRecord);
  828.         var
  829.             pt: Point;
  830.     begin
  831.         SetPort(mtd.window);
  832.         GetMouse(pt);
  833.         if PtInRect(pt, mtd.full_view) then begin
  834.             CursorSetIBeam;
  835.         end else begin
  836.             CursorSetArrow;
  837.         end;
  838.     end;
  839.  
  840.     procedure MTDActivateDeactivate (var mtd: MyTextDisplayRecord; activate: boolean);
  841.     begin
  842.         if activate then begin
  843.             ShowControl(mtd.vcontrol);
  844.             if mtd.hcontrol <> nil then begin
  845.                 ShowControl(mtd.hcontrol);
  846.             end;
  847.         end else begin
  848.             HideControl(mtd.vcontrol);
  849.             if mtd.hcontrol <> nil then begin
  850.                 HideControl(mtd.hcontrol);
  851.             end;
  852.         end;
  853.     end;
  854.  
  855.     procedure MTDDestroy (var mtd: MyTextDisplayRecord);
  856.     begin
  857.         MDisposeHandle( mtd.offsets );
  858.     end;
  859.  
  860. end.
  861.         const
  862.             hack_pts = 10;
  863.         type
  864.             PointArray = array[1..hack_pts] of integer;
  865.         const hack_points: PointArray = (-100, -100, -100, -100, -100, 800, 800, 800, 800, 800);
  866.         var
  867.             hack_pt: integer;
  868.             hack: boolean;
  869.             
  870.         function HackStillDown: boolean;
  871.         begin
  872.             if hack then begin
  873.                 HackStillDown := hack_pt <= hack_pts;
  874.             end else begin
  875.                 HackStillDown := StillDown;
  876.             end;
  877.         end;
  878.         
  879.         procedure HackGetMouse( var pt: Point );
  880.         begin
  881.             if hack then begin
  882.                 Assert( hack_pt <= hack_pts );
  883.                 pt.v := hack_points[hack_pt];
  884.                 Inc(hack_pt);
  885.             end else begin
  886.                 GetMouse( pt );
  887.             end;
  888.         end;
  889.         
  890.